home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
mask12.arc
/
MASKDEMO.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-01-07
|
8KB
|
148 lines
' MASKINPUT
' (C) 1987 By Kevin L. Curtis
' 12/30/87
'
' Routine Name: MASKINPUT
' Version: 1.0
' Written by: Kevin L. Curtis
' Language: QuickBASIC 3.0
'
' Purpose: A highly versatile user input routine that uses
' a mask$ value passed much like the picture function
' in some popular Data Base products.
'
'******************** NOTE ** NOTE ** NOTE ** NOTE ** NOTE ** NOTE ***********
'
' MASKDEMO.EXE: Demo file for maskinput does check for the display
' mode. If you are having trouble reading the screen
' then start with the command "MASKDEMO BW". This will
' ensure you of Black and White/Mono mode instead of
' color.
'*****************************************************************************
'
' Example: mask$ = "( ) - " for phone number or
' mask$ = space$(40) for blank field.
'
'Parameters passed: row%,col%,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,
' ftype% = 0
' Where: row% = Row for field input.
' col% = Column for field input.
' FieldTextAttr% = Use ADVBAS CALL CALCATTR(foreground%,_
' background%,FieldTextAttr%) to get FieldTextAttr% value or
' (BACKGROUND * 16) + FOREGROUND = Attr%.
' mask$ = What ever you want your field to look like.
' " - - " or " / / "
' DefaultVal$ = the default value for the field. This
' text will be left justified so use spaces
' if you want it in a special position.
' ReturnVal$ = the return value form user input
' ftype% = 0 for alphanumeric, -1 for numeric values only
' Exitkey% = the ASCII number of the key that exited the
' routine. Use this to verify special functions.
'
'NEXT VERSION IMPROVEMENTS: Minimum and maximum value validation with
' automatic maximum validation from length of
' mask$ if no maximum value is passed. Will
' also allow for commas and decimal places so
' you can use the data returned with the PRINT
' USING statement.
'
' NOTES: When I use this routine I define a global array for special
' keys. This will let you to check for HELP of Allowable ENTER
' or EXIT keys like: F1 - F10; TAB; CURSOR UP/DOWN PGUP/DN etc.
' This allows you to exit the routine and take care of a request-
' ed function like HELP and then return the ReturnVal$ as the
' DefaultVal$ putting the user back where they left via the
' ReturnCurrentPOS% value.
'
'This is a Shareware product. If you find it useful a donation of your
'choice 1$-10$ would be appreciated. I will be upgrading the product in
'the near future. How soon depends on your response.
'
'If you upload this file to your favorite BBS, please leave these comments
'and instructions complete and intact. As for yourself, go ahead and delete
'all of the comments so you don't have to page down 20 times every time you
'want to look at the source code.
'
'SEND DONATIONS AND/OR COMMENTS TO:
'
' SoftwareValue FLAP ->(For Little As Possible)
' 7710 Swiss
' Rowlett, TX 75088
' (214)475-7586
'
'*****************************************************************************
' These variables are a MUST for using MASKINPUT
'************** DECLARE SOME COMMON VARIABLES **************
COMMON SLColor%,StatRow%,StatCol%,LastKey%,NormAttr%,SkColor%,FieldChar%
COMMON ReturnCurrentPOS%,FGColor%,BGColor%
'*************** DIM GLOBAL ARRAYS ****************
DIM SHARED maskpos%(40,1), COLPOS%(80), FieldPos%(80)
'*************** INCLUDE FILES NEEDED ********************
REM $INCLUDE : 'Statlin.Inc' ' Contains routine for CAPS INS SCRL NUM
REM $INCLUDE : 'Getkey.Inc' ' Loop for getting a key and updating statlin
REM $INCLUDE : 'Status.Inc' ' Routine for displaying Status Line Messages
REM $INCLUDE : 'Mask.Inc' ' Mask input routine
'*********************************************************
' END OF MUST variables
'************************ MASKDEMO.EXE PROGRAM ********************
DEF SEG=&H40 : videotype% = (PEEK (7) AND PEEK(8)) AND &H03 'Check Video Type
DEF SEG 'Restore SEG to Basic Segment
IF COMMAND$ = "BW" THEN videotype% = 3
IF LEFT$(COMMAND$,1) = "C" THEN videotype% = 2
IF videotype% = 3 THEN 'IF it's MONO Monitor or B&W
call calcattr(0,7,SkColor%):CALL CALCATTR(0,7,SLColor%)
call calcattr(15,0,NormTextAttr%): call calcattr(7,0,NormAttr%)
call calcattr(0,7,FieldTextAttr%) : FGColor% = 7 : BGColor% = 0
ELSE
call calcattr(1,7,SkColor%):CALL CALCATTR(1,7,SLColor%)
call calcattr(15,1,NormTextAttr%): call calcattr(7,1,NormAttr%)
call calcattr(1,7,FieldTextAttr%) : FGColor% = 7 : BGColor% = 1
END IF
row% = 5: col% = 10:FieldChar% = 32:StatRow%= 25: StatCol%=60: LastKey% = 1
mask$ = "( ) - " ' Our mask template for user input
'mask$ = space$(40) ' Example of a blank field
DefaultVal$ = "214" ' This gives us a default area code for phone number
ReturnVal$ = "" ' NULL new value
COLOR 15,BGColor%,BGColor%:cls ' Set colors and clear screen
CALL XQPRINT("F1 FOR MORE INFORMATION - ESC TO QUIT DEMO",1,1,15,0)
call xqprint(space$(80),25,1,SkColor%,0) 'Make sure the status line is clear
'********************** SOME TEXT FOR THE DEMO *********************
call xqprint("Parameters Passed : mask$ = "+chr$(34)+"( ) - "+chr$(34),2,26,NormTextAttr%,0)
call xqprint("default_value$ = "+chr$(34)+"214"+chr$(34),3,47,NormTextAttr%,0)
call xqprint("Notice the 214 default and the cursor positioned at the",5,25,NormTextAttr%,0)
call xqprint("first available space on the field ready for your input",6,25,NormTextAttr%,0)
call xqprint("This is the status line for INS CAPS NUM & SCRL",23,33,NormTextAttr%,0)
call xqprint(chr$(25)+" "+chr$(25)+" "+chr$(25)+" "+chr$(25),24,62,NormTextAttr%,0)
call xqprint("PHONE",5,4,NormTextAttr%,0)
call MASKINPUT(row%,col%,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,-1,Exitkey%) 'CALL MASKINPUT ROUTINE
lnth% = LEN(ReturnVal$)
call xqprint("The length of the value phone is "+STR$(lnth%),8,25,NormTextAttr%,0)
call xqprint("The returned value for phone is "+ReturnVal$,9,25,NormTextAttr%,0)
LOCATE 15,1,0 : COLOR FGColor%,BGColor%,BGColor%
m1$ = "Notice how the returned value of phone is only the raw"
m2$ = "data that you typed in and not any part of the mask$"
m3$ = "value that you passed to the routine."
call xqprint(m1$,11,25,NormTextAttr%,0) : call xqprint(m2$,12,25,NormTextAttr%,0)
call xqprint(m3$,13,25,NormTextAttr%,0)
call xqprint("Try Ctrl "+chr$(27)+" and Ctrl "+chr$(26)+" for next and previous word",16,1,NormTextAttr%,0)
call xqprint("Try BACKSPACE with INSERT ON and INSERT OFF. ALT-B will blank the field.",17,1,NormTextAttr%,0)
mask$ = space$(60) 'Use space$(n%) function for blank mask values
DefaultVal$ = "Very good customer. Expect large sales volume in 1988." 'default value
call xqprint("COMMENT:",19,1,NormTextAttr%,0)
call MASKINPUT(19,10,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,0,Exitkey%)
LOCATE ,,0
call delay(2) 'delay 1 second
COLOR 7,0,0 : CLS:LOCATE ,,1
end 'bye bye - end of demo
'********************* END OF MASKDEMO PROGRAM **************************